
//////////////////////////////////////////////////
//  Devart Components
//  Copyright ?1998-2017 Devart. All right reserved.
//  CRFunctions
//////////////////////////////////////////////////


{$I Dac.inc}
unit MVC.ORMFunction;

{$IFDEF DARWIN}
  {$linkframework CoreFoundation}
{$ENDIF}

interface

uses
  Classes, SysUtils, Variants, VarUtils,
  FMTBcd,
  MVC.ORMTypes;

type
  CRBitConverter = class
  public
    class function Int32BitsToSingle(Value: Integer): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
    class function SingleToInt32Bits(Value: Single): integer; {$IFDEF USE_INLINE}inline;{$ENDIF}
    class function BytesToExtended(const Value: TBytes): Extended; {$IFDEF USE_INLINE}inline;{$ENDIF}
    class function ExtendedToBytes(Value: Extended): TBytes; {$IFDEF USE_INLINE}inline;{$ENDIF}
  end;

  function GetBcdPrecision(const Bcd: TBcd): Integer;
  function GetBcdScale(const Bcd: TBcd): Integer;
  function IsBcdInt(const Bcd: TBcd): Boolean;
  function IsBcdZero(const Bcd: TBcd): Boolean;
  function NormalizeBcd(const InBCD: TBcd; var OutBcd: TBcd; Precision, Places: Integer): Boolean;

{$IFNDEF VER17P}
  function CurrencyToBcd(const Curr: Currency): TBcd;
  function BcdToCurrency(const BCD: TBcd): Currency;
{$ENDIF}

  function TryStrToGUID(const S: string; out Value: TGUID): Boolean;

{ Delphi 6 support }

{$IFNDEF VER7P}
  procedure SafeArrayCheck(AResult: HRESULT);
  procedure SafeArrayError(AResult: HRESULT);

  function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; overload;
  function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; overload;
  function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
{$ENDIF}


{$IFNDEF VER10P}
  function IndexStr(const AText: string; const AValues: array of string): Integer;
{$ENDIF}

  procedure AssignStrings(Source: TStrings; Dest: TStrings); overload;

{$IFNDEF FPC}
{$IFNDEF NEXTGEN}
// These functions was changed in the Delphi XE and they are copied to this unit for compatibility
  function UnicodeToUtf8(Dest: PAnsiChar; Source: PWideChar; MaxBytes: Integer): Integer; overload;
  function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal; overload;
  function Utf8ToUnicode(Dest: PWideChar; Source: PAnsiChar; MaxChars: Integer): Integer; overload;
  function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PAnsiChar; SourceBytes: Cardinal): Cardinal; overload;
  function Utf8Encode(const WS: WideString): {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF};
  function Utf8Decode(const S: {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF}): WideString;
  function AnsiToUtf8(const S: AnsiString): {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF};
  function Utf8ToAnsi(const S: {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF}): AnsiString;
{$ELSE}
  function Utf8Encode(const S: string): AnsiString;
  function Utf8Decode(const S: AnsiString): string;
  function AnsiToUtf8(const S: AnsiString): AnsiString;
  function Utf8ToAnsi(const S: AnsiString): AnsiString;
{$ENDIF}
{$ELSE}
  function DetectAnsiEncoding: TEncoding;
  function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal;
  function Utf8Encode(const WS: WideString): RawByteString;
  function Utf8Decode(const S: RawByteString): WideString;
  function AnsiToUtf8(const S: AnsiString): RawByteString;
  function Utf8ToAnsi(const S: RawByteString): AnsiString;
{$ENDIF}
  function DetectUtf8LastBrockenChar(Buf: IntPtr; Size: Integer): Integer;

{$IFNDEF VER12P}
{$IFDEF FPC}
  function NextCharIndex(const S: string; Index: Integer): Integer;
  function StringOfChar(Ch: Ansichar; Count: Integer): AnsiString; overload;
  function StringOfChar(Ch: Widechar; Count: Integer): WideString; overload;
{$ENDIF}
  function CharInSet(Ch: Char; const CharSet: TSysCharSet): Boolean;
{$ELSE}
  function StrToUInt64(const S: string): UInt64;
  function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;
{$ENDIF}

{$IFNDEF VER15P}
  function SplitString(const S, Delimiters: string): TStringArray;
{$ENDIF}

{ POSIX support }

{$IFDEF POSIX}
  function GetTickCount: Cardinal;

{$IFNDEF PUREPASCAL}
  function InterlockedIncrement(var I: Integer): Integer;
  function InterlockedDecrement(var I: Integer): Integer;
{$ELSE}
{$IFDEF NEXTGEN}
  function InterlockedIncrement(var I: Integer): Integer; inline;
  function InterlockedDecrement(var I: Integer): Integer; inline;
{$ENDIF}
{$ENDIF}

{$IFNDEF NEXTGEN}
  function WideCharToMultiByte(CodePage: Cardinal; dwFlags: Cardinal;
    lpWideCharStr: PWideChar; cchWideChar: Integer; lpMultiByteStr: PAnsiChar;
    cchMultiByte: Integer; lpDefaultChar: PAnsiChar; lpUsedDefaultChar: PLongBool): Integer;
  function MultiByteToWideChar(CodePage: Cardinal; dwFlags: Cardinal;
    const lpMultiByteStr: PAnsiChar; cchMultiByte: Integer;
    lpWideCharStr: PWideChar; cchWideChar: Integer): Integer;
{$ENDIF}
{$ENDIF}

{ FPC support}

{$IFDEF FPC}
{$IFDEF UNIX}
  function GetTickCount: Cardinal;
{$ENDIF}
{$IFDEF CPU64}
  function VarArrayCreate(const Bounds: array of Integer; aVarType: TVarType): Variant;
{$ENDIF}
{$ENDIF}

  function PtrOffset(Value: IntPtr; Offset: Integer): IntPtr; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFNDEF FPC}
  function PtrOffset(Value: IntPtr; Offset: Int64): IntPtr; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
  function PtrSubstract(Value1: IntPtr; Value2: IntPtr): Integer; {$IFDEF USE_INLINE}inline;{$ENDIF}
  function PtrCompare(Value1: IntPtr; Value2: IntPtr): Integer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
  function PtrCompare(Value1: IntPtr; Offset1: Integer; Value2: IntPtr; Offset2: Integer): Integer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
  function PtrCompare(Value1: IntPtr; Offset1: Int64; Value2: IntPtr; Offset2: Int64): Integer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}

  function IsMainThread: boolean;
  function IsThread(ThreadID: TThreadID): boolean;
{$IFDEF VER12P}
  procedure SynchronizeWithMainThread(Proc: TThreadProcedure); overload;
{$ELSE}
  procedure SynchronizeWithMainThread(Proc: TProcedure); overload;
{$ENDIF}
  procedure SynchronizeWithMainThread(Method: TThreadMethod); overload;

  function GetIsClass(Obj: TObject; AClass: TClass): boolean;
  function GetIsClassByName(Obj: TObject; AClass: TClass): boolean;

  function LengthA(const AStr: AnsiString): integer; {$IFDEF USE_INLINE}inline;{$ENDIF}
  procedure SetLengthA(var AStr: AnsiString; NewLength: integer); {$IFDEF USE_INLINE}inline;{$ENDIF}

  function SwapCardinal(const Value: Cardinal): Cardinal; {$IFDEF USE_INLINE}inline;{$ENDIF}
  function GetTickInterval(StartTickCount, FinishTickCount: Cardinal): Cardinal; overload;
{$IFDEF FPC}
  function GetTickInterval(StartTickCount, FinishTickCount: UInt64): UInt64; overload;
{$ENDIF}

{$IFDEF MSWINDOWS}
  function DetectLibraryMachineType(const LibraryName: String): TMachineType;
{$ENDIF}

  function BobJenkinsHash(const Data; Len, InitData: Integer): Integer;
  function BobJenkinsHashStr(const Str: string; InitData: Integer): Integer;
  function BobJenkinsHashAStr(const AStr: AnsiString; InitData: Integer): Integer;
  function BobJenkinsHashWStr(const WStr: WideString; InitData: Integer): Integer;

type
  TIsClassFunction = function (Obj: TObject; AClass: TClass): boolean;
var
  IsClass: TIsClassFunction;

implementation

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF POSIX}
  System.Diagnostics,
{$ENDIF}
{$IFDEF DARWIN}
  CFBase, CFLocale, CFString, MacTypes,
{$ENDIF}
{$IFDEF UNIX}
  Unix, BaseUnix,
{$ENDIF}
  StrUtils,
  SysConst;

{$IFDEF FPC}
var
  InternalAnsiEncoding: TEncoding;
{$ENDIF}


function GetBcdPrecision(const Bcd: TBcd): Integer;
var
  b: Byte;
  I, J: Integer;
begin
  I := 0;
  J := Bcd.Precision - 1;

  while I < J do begin
    b := Bcd.Fraction[I div 2];
    if b <> 0 then begin
      if b shr 4 = 0 then
        Inc(I);
      break;
    end;
    I := I + 2;
  end;

  if Bcd.Precision mod 2 > 0 then begin
    b := Bcd.Fraction[J div 2];
    if b shr 4 <> 0 then begin
      Result := J - I + 1;
      exit;
    end;
    Dec(J)
  end;

  while I < J do begin
    b := Bcd.Fraction[J div 2];
    if b <> 0 then begin
      if b and $0F = 0 then
        Dec(J);
      break;
    end;
    J := J - 2;
  end;

  Result := J - I + 1;
end;

function GetBcdScale(const Bcd: TBcd): Integer;
var
  b: Byte;
  I, J: Integer;
begin
  Result := 0;

  I := Bcd.Precision - (Bcd.SignSpecialPlaces and $7F);
  J := Bcd.Precision - 1;

  if Bcd.Precision mod 2 = 1 then begin
    b := Bcd.Fraction[J div 2];
    if b shr 4 <> 0 then begin
      Result := J - I + 1;
      exit;
    end;
    Inc(I);
  end;

  while I < J do begin
    b := Bcd.Fraction[J div 2];
    if b <> 0 then begin
      if b and $0F <> 0 then
        Result := J - I  + 1
      else
        Result := J - I;
      exit;
    end;
    J := J - 2;
  end;

  if J mod 2 = 0 then begin
    b := Bcd.Fraction[J div 2];
    if b shr 4 <> 0 then
      Result := 1;
  end;
end;

function IsBcdInt(const Bcd: TBcd): Boolean;
var
  b: Byte;
  I, J: Integer;
begin
  Result := True;

  I := Bcd.Precision - (Bcd.SignSpecialPlaces and $7F);
  if I mod 2 = 1 then begin
    I := I div 2;
    b := Bcd.Fraction[I];
    Result := b and $0F = 0;
    Inc(I);
  end
  else
    I := I div 2;

  J := Bcd.Precision div 2;
  while Result and (I < J) do begin
    b := Bcd.Fraction[I];
    if b <> 0 then
      Result := False;
    Inc(I);
  end;

  if Result and (Bcd.Precision mod 2 > 0) then begin
    b := Bcd.Fraction[I];
    if b shr 4 <> 0 then
      Result := False;
  end;
end;

function IsBcdZero(const Bcd: TBcd): Boolean;
var
  i: Integer;
begin
  for i := Low(Bcd.Fraction) to High(Bcd.Fraction) do
    if Bcd.Fraction[i] <> 0 then begin
      Result := False;
      Exit;
    end;

  Result := True;
end;

function NormalizeBcd(const InBcd: TBcd; var OutBcd: TBcd; Precision, Places: Integer): Boolean;
var
  Distance: Integer;
  I: Integer;
  B: Byte;
begin
  if Precision > MaxFMTBcdFractionSize then begin
    Result := False;
    Exit;
  end;

  OutBcd := InBcd;
  Result := True;
  if not ((OutBcd.Precision = Precision) and ((OutBcd.SignSpecialPlaces and 63) = Places)) then begin
    // Verify reducing Places will only truncate 0s
    for I := 0 to (InBcd.SignSpecialPlaces and 63) - Places - 1 do begin
      if ((InBcd.Precision - I) and 1) = 0 then
        B := InBcd.Fraction[(InBcd.Precision - I + 1) div 2 - 1] and $F
      else
        B := InBcd.Fraction[(InBcd.Precision - I + 1) div 2 - 1] div $10;
      if B <> 0 then begin
        Result := False;
        break;
      end;
    end;
    Distance := (InBcd.Precision - (InBcd.SignSpecialPlaces and 63)) - (Precision - Places);
    if Distance < 0 then begin // Move left to right
      for I := Precision - 1 downto 0 do begin
        if I + Distance < 0 then
          B := 0
        else if ((I + Distance) and 1) = 0 then
          B := InBcd.Fraction[(I + Distance) div 2] div $10
        else
          B := InBcd.Fraction[(I + Distance) div 2] and $F;
        if (I and 1) = 0 then
          OutBcd.Fraction[I div 2] := (OutBcd.Fraction[I div 2] and $F) or (B * $10)
        else
          OutBcd.Fraction[I div 2] := B;
      end;
    end
    else
    if Distance > 0 then begin // move right to left
      for I := 0 to Distance - 1 do begin // Verify we're only ditching leading 0s
        if (I and 1) = 0 then
          B := InBcd.Fraction[I div 2] div $10
        else
          B := InBcd.Fraction[I div 2] and $F;
        if B <> 0 then begin
          Result := False;
          Break;
        end;
      end;

      for I := 0 to Precision - 1 do begin
        if I + Distance > InBcd.Precision then
          B := 0
        else if ((I + Distance) and 1) = 0 then
          B := InBcd.Fraction[(I + Distance) div 2] div $10
        else
          B := InBcd.Fraction[(I + Distance) div 2] and $F;
        if (I and 1) = 0 then
          OutBcd.Fraction[I div 2] := B * $10
        else
          OutBcd.Fraction[I div 2] := B or OutBcd.Fraction[I div 2];
      end;
    end;
  end;

  if (Precision and 1) <> 0 then
    OutBcd.Fraction[Precision div 2] := OutBcd.Fraction[Precision div 2] and $F0;
  if Precision < 64 then
    FillChar(OutBcd.Fraction[(Precision+1) div 2], Length(OutBcd.Fraction) - ((Precision + 1) div 2), 0);

  OutBcd.Precision := Precision;
  OutBcd.SignSpecialPlaces := (InBcd.SignSpecialPlaces and $80) + (Places and 63);
end;

{$IFNDEF VER17P}
function CurrencyToBcd(const Curr: Currency): TBcd;
begin
  CurrToBCD(Curr, Result);
end;

function BcdToCurrency(const BCD: TBcd): Currency;
begin
  BCDToCurr(BCD, Result);
end;
{$ENDIF}


function TryStrToGUID(const S: string; out Value: TGUID): Boolean;
begin
  Result := True;
  try
    Value := StringToGUID(S);
  except
    Result := False;
  end;
end;

{ Delphi 6 support }

{$IFNDEF VER7P}

procedure SafeArrayCheck(AResult: HRESULT);
begin
  if AResult and $80000000 <> 0 then
    SafeArrayError(AResult);
end;

procedure SafeArrayError(AResult: HRESULT);
begin
  case AResult of
    VAR_BADINDEX:      raise ESafeArrayBoundsError.CreateHResult(AResult, SVarArrayBounds);
    VAR_ARRAYISLOCKED: raise ESafeArrayLockedError.CreateHResult(AResult, SVarArrayLocked);
  else
    raise ESafeArrayError.CreateHResult(AResult);
  end;
end;

function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString; overload;
begin
  Result := Copy(AnsiString(AText), 1, ACount);
end;

function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; overload;
begin
  Result := Copy(AnsiString(AText), Length(AnsiString(AText)) + 1 - ACount, ACount);
end;

function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;

{$ENDIF}


{$IFNDEF VER10P}
function IndexStr(const AText: string; const AValues: array of string): Integer;
begin
  Result := AnsiIndexStr(AText, AValues);
end;
{$ENDIF}

procedure AssignStrings(Source: TStrings; Dest: TStrings);
begin
  Dest.Assign(Source);
end;

{ UTF8Encoding }

{$IFNDEF FPC}
{$IFNDEF NEXTGEN}

function UnicodeToUtf8(Dest: PAnsiChar; Source: PWideChar; MaxBytes: Integer): Integer;
begin
  Result :=  MVC.ORMFunction.UnicodeToUtf8(Dest, MaxBytes, Source, Cardinal(-1));
end;

function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal;
begin
  Result := 0;
  if Source = nil then Exit;
  if Dest <> nil then
  begin
    Result := Cardinal(WideCharToMultiByte(CP_UTF8, 0, Source, Integer(SourceChars), Dest, Integer(MaxDestBytes), nil, nil));
    if (Result > 0) and (Result <= MaxDestBytes) and (Dest[Result - 1] <> #0) then
    begin
      if Result = MaxDestBytes then
      begin
        while (Result > 1) and (Byte(Dest[Result - 1]) > $7F) and (Byte(Dest[Result - 1]) and $80 <> 0) and (Byte(Dest[Result - 1]) and $C0 <> $C0) do
          Dec(Result);
      end else
        Inc(Result);
      Dest[Result - 1] := #0;
    end;
  end else
    Result := Cardinal(WideCharToMultiByte(CP_UTF8, 0, Source, Integer(SourceChars), nil, 0, nil, nil));
end;

function Utf8ToUnicode(Dest: PWideChar; Source: PAnsiChar; MaxChars: Integer): Integer;
begin
  Result := MVC.ORMFunction.Utf8ToUnicode(Dest, MaxChars, Source, Cardinal(-1));
end;

function Utf8ToUnicode(Dest: PWideChar; MaxDestChars: Cardinal; Source: PAnsiChar; SourceBytes: Cardinal): Cardinal;
begin
  Result := 0;
  if Source = nil then Exit;
  if (Dest <> nil) and (MaxDestChars > 0) then
  begin
    Result := Cardinal(MultibyteToWideChar(CP_UTF8, 0, Source, Integer(SourceBytes), Dest, Integer(MaxDestChars)));
    if (Result > 0) and (Result <= MaxDestChars) and (Dest[Result - 1] <> #0) then
    begin
      if Result = MaxDestChars then
      begin
        if (Result > 1) and (Word(Dest[Result - 1]) >= $DC00) and (Word(Dest[Result - 1]) <= $DFFF) then
          Dec(Result);
      end else
        Inc(Result);
      Dest[Result - 1] := #0;
    end;
  end else
    Result := Cardinal(MultibyteToWideChar(CP_UTF8, 0, Source, Integer(SourceBytes), nil, 0));
end;

function Utf8Encode(const WS: WideString):{$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF};
var
  L: Integer;
  Temp: {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF};
begin
  Result := '';
  if WS = '' then Exit;
  SetLength(Temp, Length(WS) * 3); // SetLength includes space for null terminator

  L := MVC.ORMFunction.UnicodeToUtf8(PAnsiChar(Temp), Length(Temp)+1, PWideChar(WS), Length(WS));
  if L > 0 then
    SetLength(Temp, L-1)
  else
    Temp := '';
  Result := Temp;
end;

function Utf8Decode(const S: {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF}): WideString;
var
  L: Integer;
  Temp: WideString;
begin
  Result := '';
  if S = '' then Exit;
  SetLength(Temp, Length(S));

  L := MVC.ORMFunction.Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PAnsiChar(S), Length(S));
  if L > 0 then
    SetLength(Temp, L-1)
  else
    Temp := '';
  Result := Temp;
end;

function AnsiToUtf8(const S: AnsiString): {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF};
begin
  Result := Utf8Encode(WideString(S));
end;

function Utf8ToAnsi(const S: {$IFDEF VER12P}RawByteString{$ELSE}UTF8String{$ENDIF}): AnsiString;
begin
  Result := AnsiString(Utf8Decode(S));
end;

{$ELSE !NEXTGEN}
function Utf8Encode(const S: string): AnsiString;
begin
  Result := AnsiString(MarshaledAString(System.Utf8Encode(S)));
end;

function Utf8Decode(const S: AnsiString): string;
begin
  Result := System.Utf8Decode(MarshaledAString(S));
end;

function AnsiToUtf8(const S: AnsiString): AnsiString;
begin
  Result := AnsiString(MarshaledAString(System.AnsiToUtf8(string(S))));
end;

function Utf8ToAnsi(const S: AnsiString): AnsiString;
begin
  Result := AnsiString(System.Utf8ToAnsi(MarshaledAString(S)));
end;

{$ENDIF NEXTGEN}

{$ELSE FPC}

function DetectAnsiEncoding: TEncoding;

{$IFNDEF MSWINDOWS}
  type
    TCodePageMapEntry = record
      LocaleName: string;
      CodePage: Cardinal;
    end;

  const
    CodePageMapA: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'ar'; CodePage: 1256),
      (LocaleName: 'az-cyrl'; CodePage: 1251),
      (LocaleName: 'az-latn'; CodePage: 1254));

    CodePageMapBC: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'be'; CodePage: 1251),
      (LocaleName: 'bg'; CodePage: 1251),
      (LocaleName: 'cs'; CodePage: 1250));

    CodePageMapEF: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'el'; CodePage: 1253),
      (LocaleName: 'et'; CodePage: 1257),
      (LocaleName: 'fa'; CodePage: 1256));

    CodePageMapH: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'he'; CodePage: 1255),
      (LocaleName: 'hr'; CodePage: 1250),
      (LocaleName: 'hu'; CodePage: 1250));

    CodePageMapJK: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'ja'; CodePage: 932),
      (LocaleName: 'kk'; CodePage: 1251),
      (LocaleName: 'ko'; CodePage: 949));

    CodePageMapLM: array[0..2] of TCodePageMapEntry = (
      (LocaleName: 'lt'; CodePage: 1257),
      (LocaleName: 'lv'; CodePage: 1257),
      (LocaleName: 'mk'; CodePage: 1251));

    CodePageMapP: array[0..1] of TCodePageMapEntry = (
      (LocaleName: 'pa-arab'; CodePage: 1256),
      (LocaleName: 'pl'; CodePage: 1250));

    CodePageMapR: array[0..1] of TCodePageMapEntry = (
      (LocaleName: 'ro'; CodePage: 1250),
      (LocaleName: 'ru'; CodePage: 1251));

    CodePageMapS: array[0..4] of TCodePageMapEntry = (
      (LocaleName: 'sk'; CodePage: 1250),
      (LocaleName: 'sl'; CodePage: 1250),
      (LocaleName: 'sq'; CodePage: 1250),
      (LocaleName: 'sr-cyrl'; CodePage: 1251),
      (LocaleName: 'sr-latn'; CodePage: 1250));

    CodePageMapT: array[0..1] of TCodePageMapEntry = (
      (LocaleName: 'th'; CodePage: 874),
      (LocaleName: 'tr'; CodePage: 1254));

    CodePageMapUV: array[0..5] of TCodePageMapEntry = (
      (LocaleName: 'uk'; CodePage: 1251),
      (LocaleName: 'ur'; CodePage: 1256),
      (LocaleName: 'uz-arab'; CodePage: 1256),
      (LocaleName: 'uz-cyrl'; CodePage: 1251),
      (LocaleName: 'uz-latn'; CodePage: 1254),
      (LocaleName: 'vi'; CodePage: 1258));

    CodePageMapZH: array[0..6] of TCodePageMapEntry = (
      (LocaleName: 'zh_cn'; CodePage: 936),
      (LocaleName: 'zh_hk'; CodePage: 950),
      (LocaleName: 'zh-hans_hk'; CodePage: 936),
      (LocaleName: 'zh_mo'; CodePage: 950),
      (LocaleName: 'zh-hans_mo'; CodePage: 936),
      (LocaleName: 'zh_sg'; CodePage: 936),
      (LocaleName: 'zh_tw'; CodePage: 950));

  function GetPosixLocaleName: string;
  {$IFDEF MACOS}
  var
    Locale: CFLocaleRef;
    strRef: CFStringRef;
    tmpStr: Str255;
  begin
    Locale := CFLocaleCopyCurrent;
    try
      strRef := CFLocaleGetIdentifier(Locale);
      CFStringGetPascalString(strRef, @tmpStr, 255, kCFStringEncodingUTF8);
      Result := tmpStr;
    finally
      CFRelease(Locale);
    end;
  end;
  {$ENDIF}
  {$IFDEF LINUX}
  const
    defaultLocale = 'en_US';
  var
    I, Len: Integer;
    Lang: PChar;
    Temp: Pointer;
    LHasDot: Boolean;
  begin
    LHasDot := False;
    Lang := FpGetEnv(PChar('LANG'));
    if Lang = nil then
      Lang := defaultLocale;

    Len := 0;
    while (Lang[Len] <> #0) and (Lang[Len] <> '.') do
    begin
      Inc(Len);
      if Lang[Len] = '.' then
        LHasDot := True;
    end;

    SetLength(Result, Len);
    Temp := PChar(Result);
    for I := 0 to Len - 1 do
      PChar(Temp)[I] := Char(Ord(Lang[I]));
    if LHasDot then
      Result := Result + '.utf8';
  end;
  {$ENDIF}

  function FindCodePage(const Name: string; const Map: array of TCodePageMapEntry;
      var CodePage: Cardinal): Boolean;
    var
      I: Integer;
    begin
      for I := Low(Map) to High(Map) do
        if Map[I].LocaleName = Name then
        begin
          CodePage := Map[I].CodePage;
          Exit(True);
        end;
      Result := False;
    end;

  function GetACP: Cardinal;
  var
    I: Integer;
    LName: string;
    LCodePage: Cardinal;
  begin
    LName := GetPosixLocaleName;
    I := Low(string);
    while I <= High(LName) do
    begin
      if LName[I] in ['A'..'Z'] then
        Inc(LName[I], Ord('a') - Ord('A'))
      else if LName[I] = '_' then
      begin
        SetLength(LName, I - Low(string));
        Break;
      end;
      Inc(I);
    end;

    Result := 1252; // Default codepage
    if Length(LName) > 0 then
      case LName[Low(string)] of
        'a':
          if FindCodePage(LName, CodePageMapA, LCodePage) then
            Result := LCodePage;
        'b','c':
          if FindCodePage(LName, CodePageMapBC, LCodePage) then
            Result := LCodePage;
        'e','f':
          if FindCodePage(LName, CodePageMapEF, LCodePage) then
            Result := LCodePage;
        'h':
          if FindCodePage(LName, CodePageMapH, LCodePage) then
            Result := LCodePage;
        'j','k':
          if FindCodePage(LName, CodePageMapJK, LCodePage) then
            Result := LCodePage;
        'l','m':
          if FindCodePage(LName, CodePageMapLM, LCodePage) then
            Result := LCodePage;
        'p':
          if FindCodePage(LName, CodePageMapP, LCodePage) then
            Result := LCodePage;
        'r':
          if FindCodePage(LName, CodePageMapR, LCodePage) then
            Result := LCodePage;
        's':
          if FindCodePage(LName, CodePageMapS, LCodePage) then
            Result := LCodePage;
        't':
          if FindCodePage(LName, CodePageMapT, LCodePage) then
            Result := LCodePage;
        'u','v':
          if FindCodePage(LName, CodePageMapUV, LCodePage) then
            Result := LCodePage;
        'z':
          begin
            LName := GetPosixLocaleName;
            I := Low(string);
            while I <= High(LName) do
            begin
              if LName[I] in ['A'..'Z'] then
                Inc(LName[I], Ord('a') - Ord('A'))
              else if LName[I] = '@' then
              // Non Gregorian calendars include "@calendar=<calendar>" on MACOS
              begin
                SetLength(LName, I - Low(string));
                Break;
              end;
              Inc(I);
            end;
            if FindCodePage(LName, CodePageMapZH, LCodePage) then
              Result := LCodePage
            else if (Length(LName) >= 2) and (LName[Low(string) + 1] = 'h') then
              // Fallback for Chinese in countries other than cn, hk, mo, tw, sg
              Result := 936;
          end;
      end;
  end;
{$ENDIF}

begin
  if InternalAnsiEncoding = nil then
    InternalAnsiEncoding := TEncoding.GetEncoding(GetACP);
  Result := InternalAnsiEncoding;
end;

function UnicodeToUtf8(Dest: PAnsiChar; MaxDestBytes: Cardinal; Source: PWideChar; SourceChars: Cardinal): Cardinal;
begin
  Result := System.UnicodeToUtf8(Dest, MaxDestBytes, Source, SourceChars);
end;

function Utf8Encode(const WS: WideString): RawByteString;
begin
  Result := System.Utf8Encode(WS);
end;

function Utf8Decode(const S: RawByteString): WideString;
begin
  Result := System.Utf8Decode(S);
end;

function AnsiToUtf8(const S: AnsiString): RawByteString;
var
  Len: Integer;
  arr: TBytes;
begin
  Len := Length(S);
  if Len > 0 then begin
    SetLength(arr, Len);
    Move(S[1], arr[0], Len);
    Result := System.Utf8Encode(DetectAnsiEncoding.GetString(arr));
  end
  else
    Result := '';
end;

function Utf8ToAnsi(const S: RawByteString): AnsiString;
var
  Len: Integer;
  arr: TBytes;
begin
  if Length(S) > 0 then begin
    arr := DetectAnsiEncoding.GetBytes(System.UTF8Decode(S));
    Len := Length(arr);
    SetLength(Result, Len);
    Move(arr[0], Result[1], Len);
    SetCodePage(RawByteString(Result), DetectAnsiEncoding.CodePage, False);
  end
  else
    Result := '';
end;

{$ENDIF FPC}

// Return broken bytes count in the buffer tail
function DetectUtf8LastBrockenChar(Buf: IntPtr; Size: Integer): Integer;
var
  i ,j: Integer;
  Ptr: IntPtr;
begin
  Result := 0;

  if Size = 0 then
    Exit
  else if Size > 6 then begin
    Buf := PtrOffset(Buf, Size - 6);
    Size := 6;
  end;

  for i := Size - 1 downto 0 do begin
    Ptr := PtrOffset(Buf, i);

    if Byte(Ptr^) and $80 = 0 then
      Exit
    else if Byte(Ptr^) and $40 <> 0 then begin
      j := 2;
      if Byte(Ptr^) and $20 <> 0 then begin
        j := 3;
        if Byte(Ptr^) and $10 <> 0 then begin
          j := 4;
          if Byte(Ptr^) and $08 <> 0 then begin
            j := 5;
            if Byte(Ptr^) and $04 <> 0 then
              j := 6;
          end;
        end;
      end;

      Result := Size - i;
      if Result >= j then
        Result := 0;
      Exit;
    end;
  end;
end;

{$IFDEF FPC}

function NextCharIndex(const S: string; Index: Integer): Integer;
begin
  Result := Index + 1;
  assert((Index > 0) and (Index <= Length(S)));
  if SysLocale.FarEast and (S[Index] in LeadBytes) then
    Result := Index + StrCharLength(PChar(S) + Index - 1);
end;

function StringOfChar(Ch: Ansichar; Count: Integer): AnsiString;
begin
  SetLength(Result, Count);
  FillChar(Pointer(Result)^, Length(Result), Ch);
end;

function StringOfChar(Ch: Widechar; Count: Integer): WideString;
var
  i: Integer;
begin
  SetLength(Result, Count);
  for i := 1 to Count do
    Result[i] := Ch;
end;

{$ENDIF}

{$IFNDEF VER12P}

function CharInSet(Ch: Char; const CharSet: TSysCharSet): Boolean;
begin
  Result := Ch in CharSet;
end;

{$ELSE}

function StrToUInt64(const S: string): UInt64;
const
  SInvalidInteger = '''''%s'''' is not a valid integer value';
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then
    raise EConvertError.CreateFmt(SInvalidInteger, [S]);
end;

function TryStrToUInt64(const S: string; out Value: UInt64): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;
{$ENDIF}

{$IFNDEF VER15P}
function SplitString(const S, Delimiters: string): TStringArray;
var
  i, Len: Integer;
  Positions: array of Integer;
  SplitPoints: Integer;
begin
  Result := nil;

  if S <> '' then
  begin
    { Determine the length of the resulting array }
    SplitPoints := 0;
    Len := Length(S);
    SetLength(Positions, Len);
    for i := 1 to Len do
      if IsDelimiter(Delimiters, S, i) then begin
        Positions[SplitPoints] := i;
        Inc(SplitPoints);
      end;
    Positions[SplitPoints] := Len + 1;

    SetLength(Result, SplitPoints + 1);

    Result[0] := Copy(S, 1, Positions[0] - 1);
    for i := 1 to SplitPoints do
      Result[i] := Copy(S, Positions[i - 1] + 1, Positions[i] - Positions[i - 1] - 1);
  end;
end;
{$ENDIF}

{ POSIX support }

{$IFDEF POSIX}

function GetTickCount: Cardinal;
begin
  Result := TStopwatch.GetTimeStamp div 10000;
end;

{$IFNDEF PUREPASCAL}
function InterlockedIncrement(var I: Integer): Integer;
asm
{$IFNDEF CPU64}
      MOV   EDX,1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      INC   EAX
{$ELSE}
      MOV   EAX,1
 LOCK XADD  dword ptr [RCX],EAX
      INC   EAX
{$ENDIF}
end;

function InterlockedDecrement(var I: Integer): Integer;
asm
{$IFNDEF CPU64}
      MOV   EDX,-1
      XCHG  EAX,EDX
 LOCK XADD  [EDX],EAX
      DEC   EAX
{$ELSE}
      MOV   EAX,-1
 LOCK XADD  dword ptr [RCX],EAX
      DEC   EAX
{$ENDIF}
end;

{$ELSE}
function InterlockedIncrement(var I: Integer): Integer;
begin
  Result := AtomicIncrement(I);
end;

function InterlockedDecrement(var I: Integer): Integer;
begin
  Result := AtomicDecrement(I);
end;
{$ENDIF}

{$IFNDEF NEXTGEN}
function WideCharToMultiByte(CodePage: Cardinal; dwFlags: Cardinal;
  lpWideCharStr: PWideChar; cchWideChar: Integer; lpMultiByteStr: PAnsiChar;
  cchMultiByte: Integer; lpDefaultChar: PAnsiChar; lpUsedDefaultChar: PLongBool): Integer;
begin
  Result := LocaleCharsFromUnicode(CodePage, dwFlags, lpWideCharStr, cchWideChar, lpMultiByteStr, cchMultiByte, lpDefaultChar, lpUsedDefaultChar);
end;

function MultiByteToWideChar(CodePage: Cardinal; dwFlags: Cardinal;
  const lpMultiByteStr: PAnsiChar; cchMultiByte: Integer;
  lpWideCharStr: PWideChar; cchWideChar: Integer): Integer;
begin
  Result := UnicodeFromLocaleChars(CodePage, dwFlags, lpMultiByteStr, Integer(cchMultiByte), lpWideCharStr, cchWideChar);
end;
{$ENDIF}
{$ENDIF}

{ FPC support}

{$IFDEF FPC}

{$IFDEF UNIX}
function GetTickCount: Cardinal;
var
  tv: timeval;
begin
  fpgettimeofday(@tv, nil);
  {$RANGECHECKS OFF}
  Result := int64(tv.tv_sec) * 1000 + tv.tv_usec div 1000;
end;
{$ENDIF}

{$IFDEF CPU64}
function VarArrayCreate(const Bounds: array of Integer; aVarType: TVarType): Variant;
var
  i: integer;
  Bounds64: array of Int64;
begin
  SetLength(Bounds64, Length(Bounds));
  for i := 0 to Length(Bounds) - 1 do
    Bounds64[i] := Bounds[i];
  Result :=  Variants.VarArrayCreate(Bounds64, aVarType);
end;
{$ENDIF}

{$ENDIF}

{$IFOPT Q+}
  {$DEFINE OVERFLOW_ON}
  {$Q-}
{$ELSE}
  {$UNDEF OVERFLOW_ON}
{$ENDIF}

{$IFOPT R+}
  {$DEFINE RANGECHECKS_ON}
  {$R-} // for FPC
{$ELSE}
  {$UNDEF RANGECHECKS_ON}
{$ENDIF}

function PtrOffset(Value: IntPtr; Offset: Integer): IntPtr;
begin
{$IFDEF FPC}
  Result := Value + Offset;
{$ELSE}
  Result := IntPtr(NativeInt(Value) + Offset);
{$ENDIF}
end;

{$IFNDEF FPC}
function PtrOffset(Value: IntPtr; Offset: Int64): IntPtr;
begin
  Result := IntPtr(NativeInt(Value) + Offset);
end;
{$ENDIF}

function PtrSubstract(Value1: IntPtr; Value2: IntPtr): Integer;
begin
{$IFDEF FPC}
  Result := Integer(Value1 - Value2);
{$ELSE}
  Result := Integer(NativeInt(Value1) - NativeInt(Value2));
{$ENDIF}
end;

function PtrCompare(Value1: IntPtr; Value2: IntPtr): Integer;
begin
{$IFDEF FPC}
  if Value1 > Value2 then
    Result := 1
  else if Value1 < Value2 then
    Result := -1
  else
    Result := 0
{$ELSE}
  if NativeUInt(Value1) > NativeUInt(Value2) then
    Result := 1
  else if NativeUInt(Value1) < NativeUInt(Value2) then
    Result := -1
  else
    Result := 0
{$ENDIF}
end;

function PtrCompare(Value1: IntPtr; Offset1: Integer; Value2: IntPtr; Offset2: Integer): Integer;
begin
{$IFDEF FPC}
  if Value1 + Offset1 > Value2 + Offset2 then
    Result := 1
  else if Value1 + Offset1 < Value2 + Offset2 then
    Result := -1
  else
    Result := 0
{$ELSE}
  if NativeUInt(NativeInt(Value1) + Offset1) > NativeUInt(NativeInt(Value2) + Offset2) then
    Result := 1
  else if NativeUInt(NativeInt(Value1) + Offset1) < NativeUInt(NativeInt(Value2) + Offset2) then
    Result := -1
  else
    Result := 0
{$ENDIF}
end;

function PtrCompare(Value1: IntPtr; Offset1: Int64; Value2: IntPtr; Offset2: Int64): Integer;
begin
{$IFDEF FPC}
  if Value1 + Offset1 > Value2 + Offset2 then
    Result := 1
  else if Value1 + Offset1 < Value2 + Offset2 then
    Result := -1
  else
    Result := 0
{$ELSE}
  if NativeInt(Value1) + Offset1 > NativeInt(Value2) + Offset2 then
    Result := 1
  else if NativeInt(Value1) + Offset1 < NativeInt(Value2) + Offset2 then
    Result := -1
  else
    Result := 0
{$ENDIF}
end;

{$IFDEF OVERFLOW_ON}
  {$Q+}
  {$UNDEF OVERFLOW_ON}
{$ENDIF}

{$IFDEF RANGECHECKS_ON}
  {$R+}
  {$UNDEF RANGECHECKS_ON}
{$ENDIF}

function IsMainThread: boolean;
begin
{$IFDEF POSIX}
  Result := TThread.CurrentThread.ThreadID = MainThreadID;
{$ELSE}
  Result := GetCurrentThreadID = MainThreadID;
{$ENDIF}
end;

function IsThread(ThreadID: TThreadID): boolean;
begin
{$IFDEF POSIX}
  Result := TThread.CurrentThread.ThreadID = ThreadID;
{$ELSE}
  Result := GetCurrentThreadId = ThreadID;
{$ENDIF}
end;

{$IFNDEF VER7P}
type
  TFakeThread = class (TThread)
  public
    procedure Synchronize(Method: TThreadMethod);
  end;

procedure TFakeThread.Synchronize(Method: TThreadMethod);
begin
  inherited Synchronize(Method);
end;
{$ENDIF}

{$IFDEF VER12P}
procedure SynchronizeWithMainThread(Proc: TThreadProcedure);
begin
  TThread.Synchronize(nil, Proc);
end;
{$ELSE}
procedure SynchronizeWithMainThread(Proc: TProcedure);
var
  Method: TMethod;
begin
  Method.Data := nil;
  Method.Code := @Proc;
{$IFDEF VER7P}
  TThread.Synchronize(nil, TThreadMethod(Method));
{$ELSE}
  TFakeThread(nil).Synchronize(TThreadMethod(Method));
{$ENDIF}
end;
{$ENDIF}

procedure SynchronizeWithMainThread(Method: TThreadMethod);
begin
{$IFDEF VER7P}
  TThread.Synchronize(nil, Method);
{$ELSE}
  TFakeThread(nil).Synchronize(Method);
{$ENDIF}
end;

function GetIsClass(Obj: TObject; AClass: TClass): boolean;
begin
  Result := Obj is AClass;
end;

function GetIsClassByName(Obj: TObject; AClass: TClass): boolean;
var
  ParentClass: TClass;
begin
  Result := False;
  if Obj = nil then
    Exit;

  ParentClass := Obj.ClassType;
  while ParentClass <> nil do begin
    Result := ParentClass.ClassName = AClass.ClassName;
    if not Result then
      ParentClass := ParentClass.ClassParent
    else
      Break;
  end;
end;

function LengthA(const AStr: AnsiString): integer;
begin
{$IFDEF NEXTGEN}
  Result := AStr.Length();
{$ELSE}
  Result := Length(AStr);
{$ENDIF}
end;

procedure SetLengthA(var AStr: AnsiString; NewLength: integer);
begin
{$IFDEF NEXTGEN}
  AStr.SetLength(NewLength);
{$ELSE}
  SetLength(AStr, NewLength);
{$ENDIF}
end;

function SwapCardinal(const Value: Cardinal): Cardinal;
begin
  Result := ((Value {and $FF}) shl 24) or ((Value and $FF00) shl 8) or ((Value and $FF0000) shr 8) or ((Value {and $FF000000}) shr 24);
end;

function GetTickInterval(StartTickCount, FinishTickCount: Cardinal): Cardinal;
begin
  // each 49.7 days ticks are reseted, so we should take it into attention
  // and use GetTickInterval for avoiding the out of range error
  if FinishTickCount >= StartTickCount then
    Result := FinishTickCount - StartTickCount
  else
    Result := Cardinal($FFFFFFFF) - StartTickCount + FinishTickCount + 1;
end;

{$IFDEF FPC}

function GetTickInterval(StartTickCount, FinishTickCount: UInt64): UInt64;
begin
  Result := FinishTickCount - StartTickCount;
end;

{$ENDIF}

{ CRBitConverter}

class function CRBitConverter.Int32BitsToSingle(Value: Integer): Single;
begin
  Result := Single(Pointer(@Value)^);
end;

class function CRBitConverter.SingleToInt32Bits(Value: Single): integer;
begin
  Result := Integer(Pointer(@Value)^);
end;

class function CRBitConverter.BytesToExtended(const Value: TBytes): Extended;
begin
  Result := Extended(Pointer(@Value[0])^);
end;

class function CRBitConverter.ExtendedToBytes(Value: Extended): TBytes;
begin
  SetLength(Result, SizeOf(Extended));
  Extended(Pointer(@Result[0])^) := Value;
end;

{$IFDEF MSWINDOWS}
function DetectLibraryMachineType(const LibraryName: String): TMachineType;
var
  Handle: THandle;
  Offset: Integer;
  Head: Cardinal;
  MT: Word;
begin
  Result := mtUnknown;

  if not FileExists(LibraryName) then
    exit;

  Handle := FileOpen(LibraryName, fmOpenRead + fmShareDenyNone);
  try
    if Handle = INVALID_HANDLE_VALUE then
      Exit;
    if FileSeek(Handle, $3C, soFromBeginning) <> $3C then
      Exit;
    if FileRead(Handle, Offset, SizeOf(Offset)) <> SizeOf(Offset) then
      Exit;
    if FileSeek(Handle, Offset, soFromBeginning) <> Offset then
      Exit;
    if FileRead(Handle, Head, SizeOf(Head)) <> SizeOf(Head) then
      Exit;
    if Head <> $00004550 then
      Exit;
    if FileRead(Handle, MT, SizeOf(MT)) <> SizeOf(MT) then
      Exit;

    case MT of
     $01D3:
       Result := mtAM33;
     $8664:
       Result := mtAMD64;
     $01C0:
       Result := mtARM;
     $0EBC:
       Result := mtEBC;
     $014C:
       Result := mtI386;
     $0200:
       Result := mtIA64;
     $9041:
       Result := mtM32R;
     $0266:
       Result := mtMIPS16;
     $0366:
       Result := mtMIPSFPU;
     $0466:
       Result := mtMIPSFPU16;
     $01F0:
       Result := mtPOWERPC;
     $01F1:
       Result := mtPOWERPCFP;
     $0166:
       Result := mtR4000;
     $01A2:
       Result := mtSH3;
     $01A3:
       Result := mtSH3DSP;
     $01A6:
       Result := mtSH4;
     $01A8:
       Result := mtSH5;
     $01C2:
       Result := mtTHUMB;
     $0169:
       Result := mtWCEMIPSV2;
    end;
  finally
    FileClose(Handle);
  end;
end;
{$ENDIF}

{ BobJenkinsHash }

{$IFOPT Q+}
  {$DEFINE OVERFLOW_ON}
  {$Q-}
{$ELSE}
  {$UNDEF OVERFLOW_ON}
{$ENDIF}

{$IFOPT R+}
  {$DEFINE RANGECHECKS_ON}
  {$R-} // for FPC
{$ELSE}
  {$UNDEF RANGECHECKS_ON}
{$ENDIF}

function BobJenkinsHash(const Data; Len, InitData: Integer): Integer;

  function Rot(x, k: Cardinal): Cardinal; {$IFDEF USE_INLINE}inline;{$ENDIF}
  begin
    Result := (x shl k) or (x shr (32 - k));
  end;

  procedure Mix(var a, b, c: Cardinal); {$IFDEF USE_INLINE}inline;{$ENDIF}
  begin
    Dec(a, c); a := a xor Rot(c, 4); Inc(c, b);
    Dec(b, a); b := b xor Rot(a, 6); Inc(a, c);
    Dec(c, b); c := c xor Rot(b, 8); Inc(b, a);
    Dec(a, c); a := a xor Rot(c,16); Inc(c, b);
    Dec(b, a); b := b xor Rot(a,19); Inc(a, c);
    Dec(c, b); c := c xor Rot(b, 4); Inc(b, a);
  end;

  procedure Final(var a, b, c: Cardinal); {$IFDEF USE_INLINE}inline;{$ENDIF}
  begin
    c := c xor b; Dec(c, Rot(b,14));
    a := a xor c; Dec(a, Rot(c,11));
    b := b xor a; Dec(b, Rot(a,25));
    c := c xor b; Dec(c, Rot(b,16));
    a := a xor c; Dec(a, Rot(c, 4));
    b := b xor a; Dec(b, Rot(a,14));
    c := c xor b; Dec(c, Rot(b,24));
  end;

  // http://burtleburtle.net/bob/c/lookup3.c
  function HashLittle(const Data; Len, InitVal: Integer): Integer;
  type
    T12Byte = array[0..11] of byte;
    P12Byte = ^T12Byte;
    T3Cardinal = array[0..2] of Cardinal;
    P3Cardinal = ^T3Cardinal;
  var
    pb: P12Byte;
    pd: P3Cardinal absolute pb;
    a, b, c: Cardinal;
  label
    case_1, case_2, case_3, case_4, case_5, case_6,
    case_7, case_8, case_9, case_10, case_11, case_12;
  begin
    a := Cardinal($DEADBEEF) + Cardinal(Len shl 2) + Cardinal(InitVal);
    b := a;
    c := a;

    pb := @Data;

    // 4-byte aligned data
    if NativeUInt(pb) and 3 = 0 then
    begin
      while Len > 12 do
      begin
        Inc(a, pd[0]);
        Inc(b, pd[1]);
        Inc(c, pd[2]);
        Mix(a, b, c);
        Dec(Len, 12);
        pd := Pointer(NativeUInt(pd) + 12);
      end;

      case Len of
        0: begin
          Result := Integer(c);
          Exit;
        end;
        1: Inc(a, pd[0] and $FF);
        2: Inc(a, pd[0] and $FFFF);
        3: Inc(a, pd[0] and $FFFFFF);
        4: Inc(a, pd[0]);
        5:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1] and $FF);
        end;
        6:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1] and $FFFF);
        end;
        7:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1] and $FFFFFF);
        end;
        8:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1]);
        end;
        9:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1]);
          Inc(c, pd[2] and $FF);
        end;
        10:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1]);
          Inc(c, pd[2] and $FFFF);
        end;
        11:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1]);
          Inc(c, pd[2] and $FFFFFF);
        end;
        12:
        begin
          Inc(a, pd[0]);
          Inc(b, pd[1]);
          Inc(c, pd[2]);
        end;
      end;
    end
    else
    begin
      // Ignoring rare case of 2-byte aligned data. This handles all other cases.
      while Len > 12 do
      begin
        Inc(a, pb[0] + pb[1] shl 8 + pb[2] shl 16 + pb[3] shl 24);
        Inc(b, pb[4] + pb[5] shl 8 + pb[6] shl 16 + pb[7] shl 24);
        Inc(c, pb[8] + pb[9] shl 8 + pb[10] shl 16 + pb[11] shl 24);
        Mix(a, b, c);
        Dec(Len, 12);
        pb := Pointer(NativeUInt(pb) + 12);
      end;

      case Len of
        0: begin
          Result := c;
          Exit;
        end;
        1: goto case_1;
        2: goto case_2;
        3: goto case_3;
        4: goto case_4;
        5: goto case_5;
        6: goto case_6;
        7: goto case_7;
        8: goto case_8;
        9: goto case_9;
        10: goto case_10;
        11: goto case_11;
        12: goto case_12;
      end;

  case_12:
      Inc(c, pb[11] shl 24);
  case_11:
      Inc(c, pb[10] shl 16);
  case_10:
      Inc(c, pb[9] shl 8);
  case_9:
      Inc(c, pb[8]);
  case_8:
      Inc(b, pb[7] shl 24);
  case_7:
      Inc(b, pb[6] shl 16);
  case_6:
      Inc(b, pb[5] shl 8);
  case_5:
      Inc(b, pb[4]);
  case_4:
      Inc(a, pb[3] shl 24);
  case_3:
      Inc(a, pb[2] shl 16);
  case_2:
      Inc(a, pb[1] shl 8);
  case_1:
      Inc(a, pb[0]);
    end;

    Final(a, b, c);
    Result := Integer(c);
  end;

begin
  Result := HashLittle(Data, Len, InitData);
end;

function BobJenkinsHashStr(const Str: string; InitData: Integer): Integer;
begin
{$IFDEF VER12P}
  Result := BobJenkinsHash(PWideChar(Str)^, SizeOf(WideChar) * Length(Str), InitData);
{$ELSE}
  Result := BobJenkinsHash(PAnsiChar(Str)^, SizeOf(AnsiChar) * Length(Str), InitData);
{$ENDIF}
end;

function BobJenkinsHashAStr(const AStr: AnsiString; InitData: Integer): Integer;
begin
  Result := BobJenkinsHash(PAnsiChar(AStr)^, SizeOf(AnsiChar) * Length(AStr), InitData);
end;

function BobJenkinsHashWStr(const WStr: WideString; InitData: Integer): Integer;
begin
  Result := BobJenkinsHash(PWideChar(WStr)^, SizeOf(WideChar) * Length(WStr), InitData);
end;

{$IFDEF OVERFLOW_ON}
  {$Q+}
  {$UNDEF OVERFLOW_ON}
{$ENDIF}

{$IFDEF RANGECHECKS_ON}
  {$R+}
  {$UNDEF RANGECHECKS_ON}
{$ENDIF}

initialization
  if not Assigned(IsClass) then
    if IsLibrary then
      IsClass := GetIsClassByName
    else
      IsClass := GetIsClass;

finalization
{$IFDEF FPC}
  FreeAndNil(InternalAnsiEncoding);
{$ENDIF}

end.
